perm filename ERRORX.LSP[RUT,LSP] blob sn#343775 filedate 1978-03-22 generic text, type T, neo UTF8
(DECLARE (SPECIAL *NOPOINT BASE USERERRORX BRKEXP BRKTYPE BRKWHEN BRKCOMS BRKFN
		  BREAKMACROS %%MSGFLAG !VALUE %LOOKDPTH LASTPOS %%BKPOS %%CMDL
		  %PREVFN% L LAPLST %FROM %TO CHNGDFLG #%INDENT #%BKSAVE TRACE
		  BKPOS CATCH THROW ↑H)
	 (NOCALL EVALP GOFN EDBRK BKTRACE BKFIND BKTR BKTRV BKPRINVAL BKACT
		 CHNMX CHNM1 BKREAD ARGLIST %%MSGFLAG %%BKPOS %%CMDL %FROM %TO
		 CHNGDFLG)
	 (CALL %PRINFN)
	 (*FSUBR BKREAD))

(DEFPROP ERRORX
 (LAMBDA (X)
  (COND [(AND USERERRORX [USERERRORX X])]
	[T (PROG (%%ERREX %%PREV LASTPOS)
		 (SETQ %%ERREX
		       (BREAK1 (COND [(SETQ LASTPOS
					    (NEXTEV (SUB1 (STKSRCH 'ERRORX
								   (SPDLPT)
								   NIL))))
				      (SETQ %%ERREX (SPDLRT LASTPOS))]
				     [T (ERR NIL)])
			       (COND [(CONSP %%ERREX)]
				     [(AND [SETQ %%PREV (NEXTEV (SUB1 LASTPOS))]
					   [NEQ (STKNAME %%PREV) '//BREAK1])]
				     [T (ERR NIL)])
			       (COND [(ATOM %%ERREX) %%ERREX] [(CAR %%ERREX)])
			       NIL 
			       'ERRORX))
		 (OUTVAL LASTPOS %%ERREX))]))
 EXPR)

(DEFPROP BREAK1
 (LAMBDA (BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE)
  {;; The #%BKSAVE is done in BREAK1 instead of /BREAK1 in case /BREAK1 is
      restarted <typically via ↑C ↑B>; the EVAL is done to insure that an eval
      blip appears on the stack <BREAK1 might be called from compiled code>;
      Note that /BREAK1 looks for a BREAK1 eval blip immediately preceding the
      /BREAK1 which won't be the case when BREAK1 is uncompiled so LASTPOS won't
      be set correctly when debugging the ERRORX package⎇
  (SETQ #%BKSAVE
	(CONS (MCONS (PROMPT 58.) (INC NIL NIL) (OUTC NIL NIL)) #%BKSAVE))
  (EVAL '(//BREAK1)))
 EXPR)

(DEFPROP //BREAK1
 (LAMBDA NIL
  (PROG (LASTPOS %%EVALFLAG !VALUE %%MSGFLAG %%BKPOS %%CMDL)
	(AND [SETQ LASTPOS
		   (STKSRCH (COND [(EQ BRKTYPE 'ERRORX) 'ERRORX] ['//BREAK1])
			    (SPDLPT)
			    NIL)]
	     [EQ (STKNAME (SETQ %%BKPOS (NEXTEV (SUB1 LASTPOS)))) 'BREAK1]
	     [SETQ LASTPOS %%BKPOS])
	(SETQ %%BKPOS LASTPOS)
	(SETQ BKPOS NIL)
	(COND [(NULL BRKWHEN) (FROM?= BRKEXP)])
	(SETQ LASTPOS (COND [(NEXTEV (SUB1 LASTPOS))] [LASTPOS]))
	(SETQ %%CMDL (ADD1 LASTPOS))
  UNMAC (COND [(SETQ %%CMDL (STKSRCH 'MACROEXPANSION %%CMDL NIL))
	       (UNMACEXPAND (SPDLRT %%CMDL))
	       (GO UNMAC)])
  BRKLP (COND [BRKCOMS (AND [ATOM (SETQ %%CMDL (CAR BRKCOMS))]
			    [SETQ %%CMDL (NCONS %%CMDL)])
		       (SETQ BRKCOMS (CDR BRKCOMS))]
	      [T (INC NIL T)
		 (OUTC NIL T)
		 (PROMPT 58.)
		 (TALK)
		 (SETQ ↑H NIL) 	       {; Clear ↑H interrupt flag⎇
		 (LINES 1.)
		 (COND [(NULL %%MSGFLAG)
			(MSG BRKFN " Broken:" -1.)
			(SETQ %%MSGFLAG T)])
		 (PROG (BASE *NOPOINT)
		       (SETQ BASE 10.)
		       (SETQ *NOPOINT T)
		       (PRINC (LENGTH #%BKSAVE)))
		 (COND [(ATOM (SETQ %%CMDL (ERRSET (LINEREAD) ERRORX)))
			(GO BRKLP)]
		       [T (SETQ %%CMDL (CAR %%CMDL))])])
  BKLP2 (AND %%MSGFLAG [LINES 0.])
	(COND [(NULL %%CMDL) (GO BRKLP)])
	(SELECTQ
	 [CAR %%CMDL]
	 [↑ (*RSETERX 1.) (ERR NIL)]
	 [↑↑ (*RSETERX (LENGTH #%BKSAVE)) (**TOP**)]
	 [BK (BKTRACE (BKREAD 512.) '(NIL T T T))]
	 [BKE (BKTRACE (BKREAD 512.) '(NIL NIL T T))]
	 [BKF (BKTRACE (BKREAD 512.) '(NIL NIL NIL T))]
	 [BKV (BKTRACE (BKREAD 512.) '(T T T T))]
	 [BKEV (BKTRACE (BKREAD 512.) '(T NIL T T))]
	 [BKFV (BKTRACE (BKREAD 512.) '(T NIL NIL T))]
	 [> (PROG (X Y Z)
		  (SETQ X (BKREAD))
		  (COND [(ATOM (SETQ Y (SPDLRT LASTPOS)))
			 (CHNM1 (COND [(SETQ Z (NEXTEV (SUB1 LASTPOS)))
				       (SPDLRT Z)])
				Y 
				X)
			 (RPLACD (STKPTR LASTPOS) X)]
			[(AND [RPLACA BRKEXP X]
			      [NOT (EQ (SETQ Z (BKREAD //BREAK1)) '//BREAK1)])
			 (RPLACD BRKEXP (CONS Z (CDR BRKEXP)))])
		  (FROM?= NIL))]
	 [GO (COND [%%EVALFLAG] [(EVALP BRKEXP) (GO BRKER)])
	     (LINES 0.)
	     (%PRINFN !VALUE)
	     (GO LEAVE)]
	 [OK (COND [%%EVALFLAG] [(EVALP BRKEXP) (GO BRKER)]) (GO LEAVE)]
	 [EVAL (COND [(EVALP BRKEXP) (GO BRKER)])
	       (AND %%MSGFLAG [PROGN (LINES 0.) (%PRINFN !VALUE)])
	       (SETQ %%EVALFLAG T)]
	 [EDIT (PRINC '"= ")
	       (COND [(& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) T)
		      (ERRSET (EDBRK) ERRORX)]
		     [T (GO BRKER)])]
	 [?= (?= (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))))]
	 [ARGS (MAPC (FUNCTION ARGPRINT) (ARGLIST BRKFN))]
	 [& (OR [& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) T] [GO BRKER])]
	 [RETURN (COND [(EVALP (SETQ BRKEXP
				     (PROG1 (BKREAD) (SETQ %%CMDL BRKEXP))))
			(SETQ BRKEXP %%CMDL)
			(GO BRKER)])
		 (GO LEAVE)]
	 [FROM?= (FROM?= (BKREAD))]
	 [EX (COND [(OR [NULL (CDR %%CMDL)]
			[& (PROG1 (CDR %%CMDL) (SETQ %%CMDL '(NIL))) NIL])
		    (FROM?= NIL)]
		   [T (GO BRKER)])]
	 [USE (USE)]
	 [TRACE (AND TRACE [OUTC (CDDAR #%BKSAVE) NIL])
		(SETQ BKPOS T)
		(BKPOS #%INDENT)
		(PRINC '"Enter ")
		(PRIN1 BRKFN)
		(PRINC ':)
		(SETQ #%INDENT (*PLUS #%INDENT 3.))]
	 [UNTRACE (SETQ LASTPOS %%BKPOS)
		  (SETQ BKPOS NIL)
		  (FROM?= (LIST '%UNTRACE BRKFN BRKEXP))]
	 [COND
	  [(ASSOC (CAR %%CMDL) BREAKMACROS)
	   (SETQ BRKCOMS
	    (APPEND
	     (PROG (TEMP)
		   (RETURN (COND [(AND [CAR (SETQ TEMP
						  (CDR (ASSOC (CAR %%CMDL)
							      BREAKMACROS)))]
				       [LITATOM (CAR TEMP)])
				  (SUBST (CDR %%CMDL) (CAR TEMP) (CDR TEMP))]
				 [T (SUBPAIR (CAR TEMP) (CDR %%CMDL) (CDR TEMP))
				  ])))
	     BRKCOMS))
	   (GO BRKLP)]
	  [(AND [LITATOM (CAR %%CMDL)] [EQ (CHRVAL (CAR %%CMDL)) 62.])
	   (SETQ %%CMDL (AEXPLODE %%CMDL))
	   (RPLACD (CDR %%CMDL) (CONS 32. (CDDR %%CMDL)))
	   (COND [(CONSP (SETQ %%CMDL (ERRSET (READLIST %%CMDL) ERRORX)))
		  (SETQ %%CMDL (CAR %%CMDL))
		  (GO BKLP2)]
		 [T (GO BRKER)])]
	  [(ATOM (ERRSET (COND [%%MSGFLAG (%PRINFN (PROG1 (EVAL (CAR %%CMDL))
							  (LINES 0.)))]
			       [T (EVAL (CAR %%CMDL))])
			 ERRORX))
	   (GO BRKER)]])
	(SETQ %%CMDL (CDR %%CMDL))
	(GO BKLP2)
  BRKER (SETQ BRKCOMS NIL)
	(GO BRKLP)
  LEAVE (SETQ LASTPOS %%BKPOS)
	(COND [(ATOM BRKEXP)] [(GOFN (CAR BRKEXP)) (FROM?= BRKEXP)])
  LEAV2 (*RSETERX 1.)
	(RETURN !VALUE)))
 EXPR)

(DEFPROP EVALP
 (LAMBDA (#1)
  ((LAMBDA (#%BKSAVE) (*RSETERX 1.)) #%BKSAVE)
  (COND [(AND [CONSP #1] [SETQ !VALUE (GOFN (CAR #1))])]
	[T (SETQ !VALUE (ERRSET (EVAL #1) ERRORX))])
  (INC NIL NIL)
  (OUTC NIL NIL)
  (PROMPT 58.)
  (COND [(EQ !VALUE 'THROW)
	 (SETQ BRKEXP (LIST 'THROW (LIST 'QUOTE THROW) CATCH))
	 (SETQ !VALUE 'THROW)
	 NIL]
	[(ATOM !VALUE) (PRINC '?) T]
	[T (SETQ !VALUE (CAR !VALUE)) NIL]))
 EXPR)

(DEFPROP GOFN
 (LAMBDA (FN)
  (AND [EQ FN 'BRKAPPLY] [SETQ FN BRKFN])
  (COND [(MEMQ FN '(GO RETURN ERR THROW))]
	[(SETQ FN (GET FN 'ALIAS)) (MEMQ (CDR FN) '(GO RETURN ERR THROW))]))
 EXPR)

(DEFPROP PLEV (LAMBDA (X) (PRINLEV X %LOOKDPTH)) EXPR)

(DEFV %LOOKDPTH 6.)

(DEFPROP FROM?=
 (LAMBDA (X)
  (*RSETERX (STKCOUNT '//BREAK1 (SPDLPT) LASTPOS))
  (COND [X (SPREVAL LASTPOS X)] [T (SPREDO LASTPOS)]))
 EXPR)

(DEFPROP USE
 (LAMBDA NIL
  (PROG (%%X %%Y %%Z)
	(SETQ %%X (BKREAD))
	(COND [(EQ (BKREAD) 'FOR) (SETQ %%Y (BKREAD))]
	      [(PRINC '?) (SETQ %%CMDL '(NIL)) (RETURN T)])
	(COND [(ATOM (SETQ %%Z (SPDLRT LASTPOS)))
	       (COND [(EQ %%Y %%Z)
		      (RPLACD (STKPTR LASTPOS) %%X)
		      (AND [EQ BRKEXP %%Z] [SETQ BRKEXP %%X])
		      (COND [(SETQ %%Z (NEXTEV (SUB1 LASTPOS)))
			     (SETQ %%Z (SPDLRT %%Z))]
			    [T (RETURN T)])]
		     [T (PRINC '?) (RETURN T)])])
	(COND [(CHNM1 %%Z %%Y %%X)] [T (MSG 0. %%Y " not found in " %%Z)])))
 EXPR)

(DEFPROP ?=
 (LAMBDA (#COMS)
  (PROG (#COM)
	(COND [(NULL #COMS)
	       (MAPC (FUNCTION ARGPRINT) (ARGLIST (STKNAME LASTPOS)))
	       (RETURN T)])
     LP (COND [(NUMBERP (SETQ #COM (CAR #COMS)))
	       (ARGPRINT (CAR (NTH (ARGLIST (STKNAME LASTPOS)) #COM)))]
	      [T (ARGPRINT #COM)])
	(AND [SETQ #COMS (CDR #COMS)] [GO LP])))
 EXPR)

(DEFPROP &
 (LAMBDA (COMS FLAG)
  (PROG (POS COM FORFLAG)
	(COND [(NULL COMS)
	       (SETQ POS (COND [(NEXTEV (SUB1 %%BKPOS))] [%%BKPOS]))]
	      [(MEMQ (CAR COMS) '(& F)) (SETQ POS LASTPOS) (GO NEXT)]
	      [T (SETQ POS %%BKPOS)])
     LP (COND [(NULL COMS)
	       (SETQ LASTPOS POS)
	       (AND FLAG [PRIN1 (STKNAME LASTPOS)])
	       (RETURN T)]
	      [(EQ (SETQ COM (CAR COMS)) '←) (SETQ FORFLAG T) (GO NEXT)])
	(COND [(NULL (SETQ POS
			   (COND [(NUMBERP COM) (STKNTH COM POS)]
				 [(ATOM COM)
				  (PROG1 (STKSRCH COM POS FORFLAG)
					 (SETQ FORFLAG NIL))])))
	       (MSG COM 1.)
	       (PRINC '?)
	       (RETURN NIL)])
   NEXT (SETQ COMS (CDR COMS))
	(GO LP)))
 EXPR)

(DEFPROP EDBRK
 (LAMBDA NIL
  (PROG (L POS EXPR)
	(COND [(PATOM (SETQ L (SPDLRT (SETQ POS LASTPOS))))
	       (COND [(AND [SETQ POS (NEXTEV (SUB1 POS))]
			   [BKFIND (SETQ EXPR (SPDLRT POS))])
		      (SETQ EXPR
			    (EDITL (NCONS EXPR) (LIST 'F L 'UP) NIL NIL NIL))
		      (EDITL EXPR NIL NIL NIL NIL)
		      (RPLACD (STKPTR LASTPOS) (COND [EXPR (CAAR EXPR)]))]
		     [T (PRINC '"not editable.") (RETURN NIL)])]
	      [T (EDITE L NIL NIL)])
	(COND [(EQ L BRKEXP) (SETQ BRKEXP (SPDLRT LASTPOS))])))
 EXPR)

(DEFPROP *RSETERX
 (LAMBDA (N)
  (PROG NIL
	(COND [(*LESS N 1.) (RETURN NIL)])
     LP (COND [(EQ N 1.)
	       (ERRSET (PROGN (INC (CADAR #%BKSAVE) NIL)
			      (OUTC (CDDAR #%BKSAVE) NIL))
		       ERRORX)
	       (PROMPT (CAAR #%BKSAVE))
	       (SETQ #%BKSAVE (CDR #%BKSAVE))
	       (RETURN NIL)])
	(SETQ #%BKSAVE (CDR #%BKSAVE))
	(SETQ N (SUB1 N))
	(GO LP)))
 EXPR)

(DEFPROP BKTRACE
 (LAMBDA (#M #ACTION)
  (PROG (#SPD #NEXT %ACTION #NEXTEXPR)
	(SETQ #SPD (OR [PREVEV (ADD1 LASTPOS)] LASTPOS))
	(SETQ %PREVFN% NIL)
     L1 (COND [(LESSP (SETQ #M (SUB1 #M)) 0.) (SETQ %PREVFN% NIL) (RETURN T)])
	(SETQ #NEXT (FNDBRKPT (SETQ #SPD (SUB1 #SPD))))
	(COND [(NULL #NEXT) (SETQ %PREVFN% NIL) (RETURN T)])
	(SETQ %ACTION (BKACT (SETQ #NEXTEXPR (SPDLRT #NEXT)) NIL))
	(COND [(AND [CAR #ACTION] [CAR %ACTION])
	       (BKTRV #SPD 
		      #NEXT 
		      (AND [CADR #ACTION] [CADR %ACTION])
		      (AND [CADDR #ACTION] [CADDR %ACTION])
		      (AND [CADDDR #ACTION] [CADDDR %ACTION]))]
	      [(AND [CADR #ACTION] [CADR %ACTION])
	       (BKTR #SPD #NEXT (AND [CADDR #ACTION] [CADDR %ACTION]))]
	      [(AND [CADDR #ACTION] [CADDR %ACTION])
	       (SETQ %PREVFN% (PRINTLEV #NEXTEXPR 3.))]
	      [(AND [CADDDR #ACTION] [CADDDR %ACTION] [CONSP #NEXTEXPR])
	       (PRINT (CAR #NEXTEXPR))]
	      [T (SETQ #M (ADD1 #M))])
	(AND [NULL (BKACT #NEXTEXPR T)]
	     [NULL (CADR #ACTION)]
	     [SETQ #M (SUB1 #M)])
	(SETQ #SPD #NEXT)
	(GO L1)))
 EXPR)

(DEFPROP FNDBRKPT
 (LAMBDA (%SPD)
  (PROG (%OLDSPD L %FUNAME)
	(COND [(NULL (NEXTEV %SPD)) (RETURN NIL)])
	(SETQ L (SPDLRT (SETQ %SPD (ADD1 %SPD))))
     L1 (COND [(NULL (SETQ %SPD (NEXTEV (SUB1 (SETQ %OLDSPD %SPD)))))
	       (RETURN %OLDSPD)]
	      [(ATOM (SETQ %FUNAME (SPDLRT %SPD))) (RETURN %SPD)])
	(COND [(BKFIND %FUNAME) (SETQ L %FUNAME) (GO L1)])
	(RETURN %SPD)))
 EXPR)

(DEFPROP BKFIND
 (LAMBDA (X)
  (PROG NIL
     L1 (COND [(OR [EQ (CAR X) L] [AND [NOT (PATOM (CAR X))] [BKFIND (CAR X)]])
	       (RETURN T)])
	(COND [(NOT (PATOM (SETQ X (CDR X)))) (GO L1)])))
 EXPR)

(DEFPROP BKTR
 (LAMBDA (%SPD %NEXT %ACT)
  (PROG NIL
     LP (SETQ %SPD (NEXTEV %SPD))
	(AND [NULL %ACT] [EQ %SPD %NEXT] [RETURN NIL])
	(SETQ %PREVFN% (PRINTLEV (SPDLRT %SPD) 3.))
	(COND [(EQ %SPD %NEXT) (RETURN NIL)])
	(SETQ %SPD (SUB1 %SPD))
	(GO LP)))
 EXPR)

(DEFPROP BKTRV
 (LAMBDA (%SPD %NEXT %ACT1 %ACT2 %ACT3)
  (PROG (#ACTION)
	(SETQ %SPD (ADD1 %SPD))
    LP1 (SETQ %SPD (SUB1 %SPD))
	(COND [(NOT (PATOM (SPDLFT %SPD))) (GO LP3)] [(SPDLFT %SPD) (GO LP1)])
	(SETQ #ACTION (CDR (BKACT (SPDLRT %SPD) NIL)))
	(COND [(OR [AND %ACT1 [CAR #ACTION] [NEQ %SPD %NEXT]]
		   [AND %ACT2 [CADR #ACTION] [EQ %SPD %NEXT]])
	       (SETQ %PREVFN% (PRINTLEV (SPDLRT %SPD) 3.))]
	      [(AND %ACT3 [CADDR #ACTION] [CONSP (SPDLRT %SPD)] [EQ %SPD %NEXT])
	       (PRINT (CAR (SPDLRT %SPD)))])
	(COND [(EQ %SPD %NEXT) (RETURN NIL)] [T (GO LP1)])
    LP3 (TERPRI)
	(PRINC '"   ")
	(BKPRINVAL %SPD)
	(GO LP1)))
 EXPR)

(DEFPROP BKPRINVAL
 (LAMBDA (%SPD)
  (PROG (NAM SPEC)
	(PRINC (COND [(CAR (SETQ SPEC (SPDLFT %SPD)))]
		     [(SETQ NAM (ASSOC SPEC LAPLST)) (CDR NAM)]
		     [T '?]))
	(PRINC '" = ")
	(PRINLEV (COND [(EQ (SETQ %SPD (EVALV (OR [CAR SPEC] SPEC) (ADD1 %SPD)))
			    (UNBOUND))
			'UNBOUND]
		       [%SPD])
		 3.)))
 EXPR)

(DEFPROP BKACT
 (LAMBDA (#NEXT #FLAG)
  (COND [(OR [PATOM #NEXT]
	     [NOT (LITATOM (CAR #NEXT))]
	     [NULL (SETQ #NEXT (GET (CAR #NEXT) 'ERXACTION))])
	 '(T T T T)]
	[(CONSP #NEXT) #NEXT]
	[#FLAG (PRINTC #NEXT) NIL]
	[T '(NIL T NIL NIL)]))
 EXPR)

(DEFPROP CHNMX
 (LAMBDA (%IN)
  (PROG NIL
     LP (COND [(PATOM %IN) (RETURN %IN)]
	      [(EQUAL (CAR %IN) %FROM) (RPLACA %IN %TO) (SETQ CHNGDFLG T)]
	      [(CHNMX (CAR %IN))])
	(SETQ %IN (CDR %IN))
	(GO LP)))
 EXPR)

(DEFPROP CHNM1
 (LAMBDA (%IN %FROM %TO)
  (PROG (CHNGDFLG) (CHNMX %IN) (RETURN (AND CHNGDFLG %IN))))
 EXPR)

(DEFPROP BKREAD
 (LAMBDA (X)
  (COND [(AND %%CMDL [CDR %%CMDL])
	 (PROG1 (CADR %%CMDL) (SETQ %%CMDL (CDR %%CMDL)))]
	[X (CAR X)]))
 FEXPR)

(DEFPROP BKPOS
 (LAMBDA (COL)
  (PROG (WHERE)
	(SETQ COL (REMAINDER COL (*DIF (LINELENGTH NIL) 24.)))
	(LINES 0.)
	(SETQ WHERE 1.)
     LP (COND [(GREATERP WHERE COL) (RETURN COL)]
	      [(PRINC '"!  ") (SETQ WHERE (*PLUS WHERE 3.)) (GO LP)])))
 EXPR)

(DEFV BKPOS NIL)

(DEFPROP %UNTRACE
 (LAMBDA (%L)
  (PROG (CH VAL GOFL)
	(OR [SETQ GOFL (GOFN (CAR %L))]
	    [SETQ VAL (ERRSET (EVAL (CADR %L)) ERRORX)])
	(AND [NULL TRACE] [SETQ CH (OUTC NIL NIL)])
	(BKPOS (SETQ #%INDENT (*DIF #%INDENT 3.)))
	(PRIN1 (CAR %L))
	(PRINC '" = ")
	(COND [(ATOM VAL) (PRINC '?)] [T (%PRINFN (CAR VAL))])
	(AND [NULL TRACE] [OUTC CH NIL])
	(COND [GOFL (EVAL (CADR %L))]
	      [(ATOM VAL) (ERR VAL)]
	      [T (RETURN (CAR VAL))])))
 FEXPR)

(DEFV TRACE NIL)

(DEFPROP ARGLIST
 (LAMBDA (#FUNC)
  (COND [(SETQ #FUNC (GETL #FUNC '(EXPR FEXPR MACRO)))
	 (COND [(AND [SETQ #FUNC (CADADR #FUNC)] [ATOM #FUNC])
		(EVAL (LIST 'LXPD #FUNC) (PREVEV (ADD1 LASTPOS)))]
	       [#FUNC])]
	[T (MSG 0. "Arguments not found.") NIL]))
 EXPR)

(DEFPROP LXPD
 (LAMBDA (NUMARGS)
  (PROG (A)
     LP (COND [(ZEROP NUMARGS) (RETURN A)]
	      [(SETQ A (CONS (LIST 'ARG NUMARGS) A))
	       (SETQ NUMARGS (SUB1 NUMARGS))
	       (GO LP)])))
 EXPR)

(DEFPROP PREVEV
 (LAMBDA (#POS)
  (PROG (#TOP)
	(SETQ #TOP (SPDLPT))
     LP (COND [(GREATERP #POS #TOP) (RETURN NIL)]
	      [(SPDLFT #POS) (SETQ #POS (ADD1 #POS)) (GO LP)]
	      [(RETURN #POS)])))
 EXPR)

(DEFPROP STKNAME
 (LAMBDA (#POS)
  (COND [(NULL #POS) NIL]
	[(SPDLFT #POS) NIL]
	[(ATOM (SETQ #POS (SPDLRT #POS))) #POS]
	[(CAR #POS)]))
 EXPR)

(DEFPROP STKNTH
 (LAMBDA (#N #POS)
  (PROG (#FLAG)
	(COND [(MINUSP #N) (SETQ #N (MINUS #N)) (SETQ #FLAG T)])
     LP (COND [(OR [NULL #POS] [ZEROP #N]) (RETURN #POS)]
	      [#FLAG (SETQ #POS (NEXTEV (SUB1 #POS)))]
	      [(SETQ #POS (PREVEV (ADD1 #POS)))])
	(SETQ #N (SUB1 #N))
	(GO LP)))
 EXPR)

(DEFPROP STKSRCH
 (LAMBDA (#NAME #POS #FLAG)
  (PROG NIL
	(COND [(NOT (NUMBERP #POS)) (RETURN #POS)])
     LP (COND [#FLAG (SETQ #POS (PREVEV (ADD1 #POS)))]
	      [(SETQ #POS (NEXTEV (SUB1 #POS)))])
	(COND [(OR [NULL #POS] [EQ (STKNAME #POS) #NAME]) (RETURN #POS)])
	(GO LP)))
 EXPR)

(DEFPROP STKCOUNT
 (LAMBDA (#NAME #P #PEND)
  (PROG (#C)
	(SETQ #C 0.)
     LP (COND [(OR [NULL #P]
		   [NULL (SETQ #P (NEXTEV (SUB1 #P)))]
		   [GREATERP #PEND #P])
	       (RETURN #C)]
	      [(EQ #NAME (STKNAME #P)) (SETQ #C (ADD1 #C))])
	(GO LP)))
 EXPR)

(DEFPROP ARGPRINT
 (LAMBDA (X)
  (COND
   [X (COND [BKPOS (BKPOS #%INDENT)] [T (LINES 0.)])
      (PRINC '"   ")
      (PRINLEV X 1.)
      (PRINC '" = ")
      (ERRSET (%PRINFN
	       (COND [(EQ (SETQ X
				(COND [(ATOM X)
				       (EVALV X (PREVEV (ADD1 LASTPOS)))]
				      [(EVAL X (PREVEV (ADD1 LASTPOS)))]))
			  (UNBOUND))
		      'UNBOUND]
		     [X]))
	      ERRORX)]))
 EXPR)

(DEFPROP BREAKMACROS
 (NIL (-> X (> . X)) (F X (& . X)) (FIX X (EDIT . X) (FROM?= NIL)))
 VALUE)

(DEFV %PRINFN PLEV)

(DEFV USERERRORX NIL)

(DEFPROP ERRORX (NIL NIL NIL NIL) ERXACTION)

(DEFPROP BREAK1 (NIL NIL NIL NIL) ERXACTION)

(DEFPROP //BREAK1 **BREAK** ERXACTION)

(DEFPROP BRKAPPLY (NIL NIL NIL NIL) ERXACTION)

(NOCOMPILE
(DEFV ERRORXFNS ((DECLARE (SPECIAL *NOPOINT BASE USERERRORX BRKEXP BRKTYPE 
		 BRKWHEN BRKCOMS BRKFN BREAKMACROS %%MSGFLAG !VALUE %LOOKDPTH 
		 LASTPOS %%BKPOS %%CMDL %PREVFN% L LAPLST %FROM %TO CHNGDFLG 
		 #%INDENT #%BKSAVE TRACE BKPOS CATCH THROW ↑H) (NOCALL EVALP 
		 GOFN EDBRK BKTRACE BKFIND BKTR BKTRV BKPRINVAL BKACT CHNMX 
		 CHNM1 BKREAD ARGLIST %%MSGFLAG %%BKPOS %%CMDL %FROM %TO 
		 CHNGDFLG) (CALL %PRINFN) (*FSUBR BKREAD)) ERRORX BREAK1 
		 //BREAK1 EVALP GOFN PLEV (V: %LOOKDPTH) FROM?= USE ?= & 
		 EDBRK *RSETERX BKTRACE FNDBRKPT BKFIND BKTR BKTRV BKPRINVAL 
		 BKACT CHNMX CHNM1 BKREAD BKPOS %UNTRACE (V: (TRACE NIL)) 
		 ARGLIST LXPD PREVEV STKNAME STKNTH STKSRCH STKCOUNT ARGPRINT 
		 (P: (VALUE) BREAKMACROS) (V: %PRINFN (USERERRORX NIL)) 
		 (P: (ERXACTION) ERRORX BREAK1 //BREAK1 BRKAPPLY)))
)